/*rx
    $VER: $Id: ExamineIndex.mm,v 1.9 1994/06/20 01:08:25 tf Exp $

    This script compares the LOCAL index file with the Aminet INDEX
    file and reports differences in existance, path and comment.
    If either COMMENT or RELOCATE keyword (or both) were given in the
    command-line then the file position or filenote will be modified
    respectively if needed.

    (The Aminet directory hierarchy can be created using 'MakeTree.rexx')

    This ARexx script needs the AmigaDOS commands "List", "Sort",
    "Search", "Filenote", "Copy" and "Delete" available in your path.

    Initial revision by Tobias Ferber, 24-Feb-94
*/

options results
options failat 10

call pragma('S',102400)

/* initialize globals */

mirrorpath  = ""  /* e.g. downloads:aminet/      */
kickpath    = ""  /* e.g. incoming:              */
localindex  = ""  /* e.g. downloads:aminet/LOCAL */
masterindex = ""  /* e.g. downloads:aminet/INDEX */

fastprefix  = "FAST."
tempfile    = "T:ExamineIndexTemp." || pragma('Id')
template    = "FILE/K/A,WITH/K/A,PATH/K,RELOCATE/S,KICK/K,COMMENT/S,MAKEPATH/S,FAST/S,AUTO/S"

args        = ""
cliopts     = ""

dg       = 0  /* gauge increment */
gstepN   = 0

ESC      = '1b'x

signal on HALT
signal on BREAK_C
signal on BREAK_D


/* parse args */

do ac=1 while ac <= arg()
  av= arg(ac)
  select
    when upper(av) = "FILE" then do
      if ac < arg() then do
        ac= ac+1
        localindex= arg(ac)
        end
      else exit bad_args('Missing local index filename after' ESC'bFILE'ESC'n keyword.')
      end /* FILE */

    when upper(av) = "WITH" then do
      if ac < arg() then do
        ac= ac+1
        masterindex= arg(ac)
        end
      else exit bad_args('Missing master index filename after' ESC'bWITH'ESC'n keyword.')
      end /* WITH */

    when upper(av) = "PATH" then do
      if ac < arg() then do
        ac= ac+1
        mirrorpath= arg(ac)
        if words(mirrorpath) < 1 then mirrorpath= pragma('D')
        end
      else exit bad_args('Missing mirror pathname after' ESC'bPATH'ESC'n keyword.')
      end /* PATH */

    when upper(av) = "KICK" then do
      if ac < arg() then do
        ac= ac+1
        kickpath= arg(ac)
        if words(kickpath) < 1 then kickpath= pragma('D')
        end
      else exit bad_args('Missing destination pathname after' ESC'bKICK'ESC'n keyword.')
      end /* KICK */

    when upper(av) = "RELOCATE" then cliopts = cliopts || 'cd'
    when upper(av) = "COMMENT"  then cliopts = cliopts || 'n'
    when upper(av) = "MAKEPATH" then cliopts = cliopts || 'm'
    when upper(av) = "FAST"     then cliopts = cliopts || 'f'
    when upper(av) = "AUTO"     then cliopts = cliopts || 'a'

    otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')

  end /* select */

end /* do */

call pragma('W','N')


/* try to get missing local index file */

if words(localindex) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select local index file..."' NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then localindex= result
  end

if words(localindex) < 1 then
  exit bad_args("Not enough arguments for ExamineIndex...  Exiting...")

if ~exists(localindex) then do
  REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                BODY    '"ExamineIndex failed to locate your local index*n*n' ||,
                        ESC'c'ESC'b' || localindex || ESC'n'ESC'l'            || '"',
                GADGETS '"Exit"'
  exit 10
  end


/* try to get missing master index path or filename */

if words(masterindex) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  if pos('f',cliopts) > 0 then REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select fast index path..."' DRAWERSONLY NOICONS
                          else REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select master index file..."' NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then masterindex= result
  end

if words(masterindex) < 1 then
  exit bad_args("Not enough arguments for ExamineIndex...  Exiting...")

if ~exists(masterindex) then do
  REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                BODY    '"ExamineIndex failed to locate your master index*n*n' ||,
                        ESC'c'ESC'b' || masterindex || ESC'n'ESC'l'            || '"',
                GADGETS '"Exit"'
  exit 10
  end


/* eventually try to get missing from path */

if (pos('cd',cliopts) > 0) | (pos('n',cliopts) > 0) | (pos('m',cliopts) > 0) then do
  if words(mirrorpath) < 1 then do
    cwd= strip(pragma('D'),'B','"')
    REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select the mirror directory..."' DRAWERSONLY NOICONS
    if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then mirrorpath= result
    end

  if words(mirrorpath) < 1 then
    exit bad_args("Not enough arguments for ExamineIndex...  Exiting...")

  if ~exists(mirrorpath) then do
    REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                  BODY    '"ExamineIndex failed to locate your mirror directory*n*n' ||,
                          ESC'c'ESC'b' || mirrorpath || ESC'n'ESC'l'                 || '"',
                  GADGETS '"Exit"'
    exit 10
    end
  end


/* eventually create the kick path */

if words(kickpath) > 0 then do
  if ~exists(kickpath) & canexist(kickpath) then do
    if pos('m',cliopts) > 0 then call makepath(kickpath)
    else do
      REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                    BODY    '"Destination path*n*n'                      ||,
                            ESC'c'ESC'b' || kickpath || ESC'n'ESC'l*n*n' ||,
                            'does not exist.  Shall I create it?'        || '"',
                    GADGETS '"_Yes|_No"'
      if result > 0 then do
        if result > 1 then cliopts = cliopts || 'm'
        call makepath(kickpath)
        end
      else do
        REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                      BODY    '"Operation canceled."',
                      GADGETS '"Exit"'
        exit
        end
      end
    if exists(kickpath) then MESSAGE '"'kickpath'   [created]"'
    end

  if ~exists(kickpath) then do
    REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                  BODY    '"ExamineIndex failed to create your destination path*n*n' ||,
                          ESC'c'ESC'b' || kickpath || ESC'n'ESC'l'                   || '"',
                  GADGETS '"Exit"'
    exit 10
    end
  end


signal on ERROR
signal on IOERR

signal on FAILURE
/*signal on NOVALUE*/
signal on SYNTAX


CALL init_gauge(localindex,2)


/* do the hard part */

if ~open('fp',localindex,'R') then do
  REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                BODY    '"Could not open local index file*n*n'     ||,
                        ESC'c'ESC'b' || localindex || ESC'n'ESC'l' || '"',
                GADGETS '"Exit"'
  exit 10
  end

do until eof('fp')

  str= strip( readln('fp') )
  if (words(str) > 0) & (left(str,1) ~= '|') then do
    parse var str fname pname fsize comment

    if pos('f',cliopts) > 0 then masterfile = tackon(masterindex,fastprefix) || upper(left(fname,1))
                            else masterfile = masterindex

    if exists(masterfile) then do
      MESSAGE transquote('Searching for "'tackon(pname,fname)'" in "'masterfile'" ...')
      if pname = '.' then pname = ""

      signal off ERROR
      address command searchcmd(fname,masterfile)
      signal on ERROR

      CALL step_gauge(1)

      if ~open('tfp',tempfile,'R') then do
          REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                        BODY    '"Search failed.  Could not open*n*n'    ||,
                                ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
                        GADGETS '"Exit"'
        call close('fp')
        exit 10
        end

      master_pname   = ""
      master_comment = ""
      matches = 0

      do until eof('tfp') | matches > 1
        str= strip( readln('tfp') )

        if words(str) > 0 then do
          parse var str f d . 38 c

          if f = fname then do
            if matches = 0 then do
              master_pname= d
              master_comment= c
              matches= matches + 1
              end
            else if (master_pname ~= d) | (master_comment ~= c) then matches= matches + 1
            end

          end

          /* else we matched the comment */

        end /* scan ifp */

      call close('tfp')
      address command 'Delete QUIET FILE "' || tempfile || '"'

      /**/

      select /* #of matches */

        when matches = 1 then do
          fromfile = tackon( tackon(mirrorpath, pname       ), fname)
          tofile   = tackon( tackon(mirrorpath, master_pname), fname)

          if exists(fromfile) then do   /* Maybe someone deleted our fromfile meanwhile... */

            if comment ~= master_comment then do
              if pos('n',cliopts) < 1 then
                MESSAGE transquote('Filenote of "'fname'" has changed from "'comment'" to "'master_comment'"')
              else do
                MESSAGE transquote('Changing filenote of "'fname'" from "'comment'" to "'master_comment'"')
                address command 'Filenote QUIET FILE' fromfile 'COMMENT' transquote(master_comment)
                end
              end /* comment ~= master_comment */

            if pname ~= master_pname then do

              if pos('cd',cliopts) < 1 then
                MESSAGE transquote('File "'fname'" has moved from "'pname'" to "'master_pname'"')

              else do
                MESSAGE transquote('Moving "'fname'" from "'pname'" to "'master_pname'"')
                destpath= tackon(mirrorpath,master_pname)
                if ~exists(destpath) & canexist(destpath) then do
                  if pos('m',cliopts) > 0 then call makepath(destpath)
                  else do
                    REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                                  BODY    '"Destination path*n*n'                      ||,
                                          ESC'c'ESC'b' || destpath || ESC'n'ESC'l*n*n' ||,
                                          'does not exist.  Shall I create it?'        || '"',
                                  GADGETS '"_Yes|_All|_No"'
                    if result > 0 then do
                      if result > 1 then cliopts = cliopts || 'm'
                      call makepath(destpath)
                      end
                    end
                  if exists(destpath) then MESSAGE '"'destpath'   [created]"'
                  end

                if exists(destpath) then do
                  if exists(tofile) then do
                    if pos('r',cliopts) > 0 then address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                    else do
                      REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                                    BODY    '"'ESC'c'ESC'b' || tofile || ESC'n'ESC'l*n*n' ||,
                                            'already exists.  Shall I replace it?'        || '"',
                                    GADGETS '"_Yes|_All|_No"'
                      if result > 0 then do
                        if result > 1 then cliopts = cliopts || 'r'
                        address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                        end
                      else MESSAGE transquote(tofile 'not replaced')
                      end
                    end
                  else address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'

                  if exists(tofile) then address command 'Delete QUIET FILE "'fromfile'"'
                  end

                else MESSAGE transquote('Warning: "'fname'" ignored.  (Destination path "'destpath'" not created)')
                end
              end /* pname ~= master_pname */

            end
          else MESSAGE transquote('Warning: "'fromfile'" does not exist anymore ... ignored')
          end /* matches = 1 */

        when matches = 0 then do
          MESSAGE transquote('Warning: file "'fname'" not found in master index file "'masterfile'"')

          if words(kickpath) > 0 then do

            fromfile = tackon(tackon(mirrorpath, pname), fname)
            tofile   = tackon(kickpath, fname)

            if exists(fromfile) then do
              if exists(tofile) then do
                if (pos('r',cliopts) < 1) then do
                  REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                                BODY    '"'ESC'c'ESC'b' || tofile || ESC'n'ESC'l*n*n' ||,
                                        'already exists.  Shall I replace it?'        || '"',
                                GADGETS '"_Yes|_All|_No"'
                  if result > 0 then do
                    if result > 1 then cliopts = cliopts || 'r'
                    MESSAGE transquote('Overwriting "'tofile'" with "'fromfile'"')
                    address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                    end
                  else MESSAGE transquote(tofile 'not replaced')
                  end
                else do
                  MESSAGE transquote('Overwriting "'tofile'" with "'fromfile'"')
                  address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                  end
                end
              else do
                MESSAGE transquote('Moving "'fromfile'" to "'kickpath'" ...')
                address command 'Copy QUIET CLONE FROM "'fromfile'" TO "'tofile'"'
                end

              if exists(tofile) then address command 'Delete QUIET FILE "'fromfile'"'
              end /* exists(fromfile) */

            else MESSAGE transquote('Warning: "'fromfile'" does not exist anymore ... ignored')
            end
          end /* matches = 0 */

        otherwise do
          MESSAGE transquote('Warning: filename "'fname'" is ambiguous... skipped')
          end

        end /* select */

      end /* exists(masterfile) */

    else MESSAGE transquote('Master index file "'masterfile'" does not exist ... "'fname'" skipped')
    end /* have fname */

  CALL step_gauge(1)

  end /* do scan fp */

call close('fp')
step_gauge(100)
MESSAGE '"done."'
IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
EXIT 0

/**/

bad_args: PROCEDURE EXPOSE template ESC
  PARSE ARG msg

  REQUESTCHOICE TITLE   '"ExamineIndex Request"',
                BODY    '"' || msg || '*n*n'                     ||,
                        'ExamineIndex args template:*n*n'        ||,
                        ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
                GADGETS '"Okay"'
  RETURN 0


/* generate the search command string */

searchcmd: PROCEDURE EXPOSE tempfile
  PARSE ARG pattern,file
  return 'Search NONUM > "'tempfile'" FROM "'file'" SEARCH "'pattern'"'
  /*return 'AGrep > "'tempfile'"' '"'pattern'"' '"'file'"'*/

/*@*/


/* translate '"' into '*"' and '*' into '**' */

transquote: procedure
  parse arg s
  t= s
  q= max( lastpos('*',s), lastpos('"',s) )
  do while q > 0
    t= insert('*',t,q-1,1)
    s= left(s,q-1)
    q= max( lastpos('*',s), lastpos('"',s) )
    end
  return '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: procedure
  parse arg path
  if (words(path) > 0) & (right(path,1) ~= ':') then do
    if right(path,1) = '/' then path= left(path,length(path)-1)
    if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
                                             else path= left(path,lastpos(':',path))
    end
  return path


/* return the file part of a pathname */

fileonly: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  p= max( lastpos(':',path), lastpos('/',path) )
  if(p>0) then return substr(path,p+1)
          else return path


/* concatenate the filename to the pathname and return the resulting string */

tackon: procedure
  parse arg path,file
  do while left(file,1) = '/'
    file= substr(file,2)
    path= pathonly(path)
    end
  if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  if (right(file,1) = '/') then file= left(file,length(file)-1)
  return path || file


/* create all non-existant directories in a path */

makepath: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  if ~exists(path) then do
    call makepath( pathonly(path) )
    address command 'MakeDir NAME "'path'"'
    end
  return 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: procedure
  parse upper arg path
  if pos(':',path) < 1 then return 1 /* current device */
  call pragma('W','N')
  return exists( left(path,lastpos(':',path)) )


/* stretch the blue completion bar */

step_gauge: PROCEDURE EXPOSE dg gstepN
  ARG increment
  gstepN= gstepN + 1
  c= MIN(TRUNC(gstepN * increment * dg),100)
  COMPLETE c
  IF c >= 100 THEN WORKING '"done."'
  RETURN 0


/* initialize the gauge increment by counting the #of steps to be performed */

init_gauge: PROCEDURE EXPOSE dg gstepN
  PARSE ARG fname,steps_per_entry

  dg = 0         /* gauge increment */
  gstepN = 0     /* #of performed steps */

  IF OPEN('fp',fname,'R') THEN DO
    numentries= 0
    DO UNTIL EOF('fp')
      IF WORDS(READLN('fp')) > 0 THEN
        numentries= numentries+1
      END
    WORKING '"Processing' numentries 'entries..."'
    dg = 100 / (numentries * steps_per_entry)
    CALL SEEK('fp',0,'B')
    CALL CLOSE('fp')
    END

  MESSAGE CLEAR; MESSAGE OPEN
  COMPLETE 0
  RETURN 0


/* error/break handling */

IOERR:
ERROR:
  err= rc
  ESC = '1b'x

  signal off ERROR
  signal off IOERR

  WORKING '"I/O problem trapped... Execution halted."'
  MESSAGE '"I/O problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"ExamineIndex Error Trap' err'"',
                BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
                GADGETS '"I''ll better exit"'
  exit


FAILURE:
NOVALUE:
SYNTAX:
  err= rc
  ESC = '1b'x

  signal off FAILURE
  signal off NOVALUE
  signal off SYNTAX

  WORKING '"Internal problem trapped... Execution halted."'
  MESSAGE '"Internal problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"ExamineIndex Internal Error' err'"',
                BODY    '"ExamineIndex seems to have an internal problem in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                         || '"',
                GADGETS '"I''ll better exit"'
  exit


HALT:
BREAK_C:
BREAK_D:
  signal off HALT
  signal off BREAK_C
  signal off BREAK_D

  WORKING '"Break signal trapped... Execution halted."'
  MESSAGE '"Break signal trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"ExamineIndex Break Trap"',
                BODY    '"Script execution halted."',
                GADGETS '"Stop"'
  exit
